home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / diary-ins.el < prev    next >
Lisp/Scheme  |  1993-06-18  |  10KB  |  281 lines
  1. ;;; diary-ins.el --- calendar functions for adding diary entries.
  2.  
  3. ;; Copyright (C) 1990 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
  6. ;; Keywords: diary, calendar
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  12. ;; accepts responsibility to anyone for the consequences of using it
  13. ;; or for whether it serves any particular purpose or works at all,
  14. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  15. ;; License for full details.
  16.  
  17. ;; Everyone is granted permission to copy, modify and redistribute
  18. ;; GNU Emacs, but only under the conditions described in the
  19. ;; GNU Emacs General Public License.   A copy of this license is
  20. ;; supposed to have been given to you along with GNU Emacs so you
  21. ;; can know your rights and responsibilities.  It should be in a
  22. ;; file named COPYING.  Among other things, the copyright notice
  23. ;; and this notice must be preserved on all copies.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; This collection of functions implements the diary insertion features as
  28. ;; described in calendar.el.
  29.  
  30. ;; Comments, corrections, and improvements should be sent to
  31. ;;  Edward M. Reingold               Department of Computer Science
  32. ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  33. ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  34. ;;                                   Urbana, Illinois 61801
  35.  
  36. ;;; Code:
  37.  
  38. (require 'diary)
  39.  
  40. (defun make-diary-entry (string &optional nonmarking file)
  41.   "Insert a diary entry STRING which may be NONMARKING in FILE.
  42. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
  43.   (find-file-other-window
  44.    (substitute-in-file-name (if file file diary-file)))
  45.   (goto-char (point-max))
  46.   (insert
  47.    (if (bolp) "" "\n")
  48.    (if nonmarking diary-nonmarking-symbol "")
  49.    string " "))
  50.  
  51. (defun insert-diary-entry (arg)
  52.   "Insert a diary entry for the date indicated by point.
  53. Prefix arg will make the entry nonmarking."
  54.   (interactive "P")
  55.   (make-diary-entry
  56.    (calendar-date-string
  57.     (or (calendar-cursor-to-date)
  58.         (error "Cursor is not on a date!"))
  59.     t t)
  60.    arg))
  61.  
  62. (defun insert-weekly-diary-entry (arg)
  63.   "Insert a weekly diary entry for the day of the week indicated by point.
  64. Prefix arg will make the entry nonmarking."
  65.   (interactive "P")
  66.   (make-diary-entry
  67.    (calendar-day-name
  68.     (or (calendar-cursor-to-date)
  69.         (error "Cursor is not on a date!")))
  70.    arg))
  71.  
  72. (defun insert-monthly-diary-entry (arg)
  73.   "Insert a monthly diary entry for the day of the month indicated by point.
  74. Prefix arg will make the entry nonmarking."
  75.   (interactive "P")
  76.   (let* ((calendar-date-display-form
  77.           (if european-calendar-style
  78.               '(day " * ")
  79.             '("* " day))))
  80.     (make-diary-entry
  81.      (calendar-date-string
  82.       (or (calendar-cursor-to-date)
  83.           (error "Cursor is not on a date!"))
  84.       t)
  85.      arg)))
  86.  
  87. (defun insert-yearly-diary-entry (arg)
  88.   "Insert an annual diary entry for the day of the year indicated by point.
  89. Prefix arg will make the entry nonmarking."
  90.   (interactive "P")
  91.   (let* ((calendar-date-display-form
  92.           (if european-calendar-style
  93.               '(day " " monthname)
  94.             '(monthname " " day))))
  95.     (make-diary-entry
  96.      (calendar-date-string
  97.       (or (calendar-cursor-to-date)
  98.           (error "Cursor is not on a date!"))
  99.       t)
  100.      arg)))
  101.  
  102. (defun insert-anniversary-diary-entry (arg)
  103.   "Insert an anniversary diary entry for the date given by point.
  104. Prefix arg will make the entry nonmarking."
  105.   (interactive "P")
  106.   (let* ((calendar-date-display-form
  107.           (if european-calendar-style
  108.               '(day " " month " " year)
  109.             '(month " " day " " year))))
  110.     (make-diary-entry
  111.      (format "%s(diary-anniversary %s)"
  112.              sexp-diary-entry-symbol
  113.              (calendar-date-string
  114.               (or (calendar-cursor-to-date)
  115.                   (error "Cursor is not on a date!"))
  116.               nil t))
  117.      arg)))
  118.  
  119. (defun insert-block-diary-entry (arg)
  120.   "Insert a block diary entry for the days between the point and marked date.
  121. Prefix arg will make the entry nonmarking."
  122.   (interactive "P")
  123.   (let* ((calendar-date-display-form
  124.           (if european-calendar-style
  125.               '(day " " month " " year)
  126.             '(month " " day " " year)))
  127.          (cursor (or (calendar-cursor-to-date)
  128.                      (error "Cursor is not on a date!")))
  129.          (mark (or (car calendar-mark-ring)
  130.                    (error "No mark set in this buffer")))
  131.          (start)
  132.          (end))
  133.     (if (< (calendar-absolute-from-gregorian mark)
  134.            (calendar-absolute-from-gregorian cursor))
  135.         (setq start mark
  136.               end cursor)
  137.       (setq start cursor
  138.               end mark))
  139.     (make-diary-entry
  140.      (format "%s(diary-block %s %s)"
  141.       sexp-diary-entry-symbol
  142.       (calendar-date-string start nil t)
  143.       (calendar-date-string end nil t))
  144.      arg)))
  145.  
  146. (defun insert-cyclic-diary-entry (arg)
  147.   "Insert a cyclic diary entry starting at the date given by point.
  148. Prefix arg will make the entry nonmarking."
  149.   (interactive "P")
  150.   (let* ((calendar-date-display-form
  151.           (if european-calendar-style
  152.               '(day " " month " " year)
  153.             '(month " " day " " year))))
  154.     (make-diary-entry
  155.      (format "%s(diary-cyclic %d %s)"
  156.              sexp-diary-entry-symbol
  157.              (calendar-read "Repeat every how many days: "
  158.                             '(lambda (x) (> x 0)))
  159.              (calendar-date-string
  160.               (or (calendar-cursor-to-date)
  161.                   (error "Cursor is not on a date!"))
  162.               nil t))
  163.      arg)))
  164.  
  165. (defun insert-hebrew-diary-entry (arg)
  166.   "Insert a diary entry.
  167. For the Hebrew date corresponding to the date indicated by point.
  168. Prefix arg will make the entry nonmarking."
  169.   (interactive "P")
  170.   (let* ((calendar-month-name-array
  171.           calendar-hebrew-month-name-array-leap-year))
  172.     (make-diary-entry
  173.      (concat
  174.       hebrew-diary-entry-symbol
  175.       (calendar-date-string 
  176.        (calendar-hebrew-from-absolute
  177.         (calendar-absolute-from-gregorian
  178.          (or (calendar-cursor-to-date)
  179.              (error "Cursor is not on a date!"))))
  180.        nil t))
  181.      arg)))
  182.  
  183. (defun insert-monthly-hebrew-diary-entry (arg)
  184.   "Insert a monthly diary entry.
  185. For the day of the Hebrew month corresponding to the date indicated by point.
  186. Prefix arg will make the entry nonmarking."
  187.   (interactive "P")
  188.   (let* ((calendar-date-display-form
  189.           (if european-calendar-style '(day " * ") '("* " day )))
  190.          (calendar-month-name-array
  191.           calendar-hebrew-month-name-array-leap-year))
  192.     (make-diary-entry
  193.      (concat
  194.       hebrew-diary-entry-symbol
  195.       (calendar-date-string 
  196.        (calendar-hebrew-from-absolute
  197.         (calendar-absolute-from-gregorian
  198.          (or (calendar-cursor-to-date)
  199.              (error "Cursor is not on a date!"))))))
  200.      arg)))
  201.  
  202. (defun insert-yearly-hebrew-diary-entry (arg)
  203.   "Insert an annual diary entry.
  204. For the day of the Hebrew year corresponding to the date indicated by point.
  205. Prefix arg will make the entry nonmarking."
  206.   (interactive "P")
  207.   (let* ((calendar-date-display-form
  208.           (if european-calendar-style
  209.               '(day " " monthname)
  210.             '(monthname " " day)))
  211.          (calendar-month-name-array
  212.           calendar-hebrew-month-name-array-leap-year))
  213.     (make-diary-entry
  214.      (concat
  215.       hebrew-diary-entry-symbol
  216.       (calendar-date-string 
  217.        (calendar-hebrew-from-absolute
  218.         (calendar-absolute-from-gregorian
  219.          (or (calendar-cursor-to-date)
  220.              (error "Cursor is not on a date!"))))))
  221.      arg)))
  222.  
  223. (defun insert-islamic-diary-entry (arg)
  224.   "Insert a diary entry.
  225. For the Islamic date corresponding to the date indicated by point.
  226. Prefix arg will make the entry nonmarking."
  227.   (interactive "P")
  228.   (let* ((calendar-month-name-array calendar-islamic-month-name-array))
  229.     (make-diary-entry
  230.      (concat
  231.       islamic-diary-entry-symbol
  232.       (calendar-date-string 
  233.        (calendar-islamic-from-absolute
  234.         (calendar-absolute-from-gregorian
  235.          (or (calendar-cursor-to-date)
  236.              (error "Cursor is not on a date!"))))
  237.        nil t))
  238.      arg)))
  239.  
  240. (defun insert-monthly-islamic-diary-entry (arg)
  241.   "Insert a monthly diary entry.
  242. For the day of the Islamic month corresponding to the date indicated by point.
  243. Prefix arg will make the entry nonmarking."
  244.   (interactive "P")
  245.   (let* ((calendar-date-display-form
  246.           (if european-calendar-style '(day " * ") '("* " day )))
  247.          (calendar-month-name-array calendar-islamic-month-name-array))
  248.     (make-diary-entry
  249.      (concat
  250.       islamic-diary-entry-symbol
  251.       (calendar-date-string 
  252.        (calendar-islamic-from-absolute
  253.         (calendar-absolute-from-gregorian
  254.          (or (calendar-cursor-to-date)
  255.              (error "Cursor is not on a date!"))))))
  256.      arg)))
  257.  
  258. (defun insert-yearly-islamic-diary-entry (arg)
  259.   "Insert an annual diary entry.
  260. For the day of the Islamic year corresponding to the date indicated by point.
  261. Prefix arg will make the entry nonmarking."
  262.   (interactive "P")
  263.   (let* ((calendar-date-display-form
  264.           (if european-calendar-style
  265.               '(day " " monthname)
  266.             '(monthname " " day)))
  267.          (calendar-month-name-array calendar-islamic-month-name-array))
  268.     (make-diary-entry
  269.      (concat
  270.       islamic-diary-entry-symbol
  271.       (calendar-date-string 
  272.        (calendar-islamic-from-absolute
  273.         (calendar-absolute-from-gregorian
  274.          (or (calendar-cursor-to-date)
  275.              (error "Cursor is not on a date!"))))))
  276.      arg)))
  277.  
  278. (provide 'diary-ins)
  279.  
  280. ;;; diary-ins.el ends here
  281.